perm filename B.F4[MSS,LCS] blob sn#249496 filedate 1976-11-27 generic text, type T, neo UTF8
00010	C******* LOAD WITH EXT.FAI *******
00100		DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1)
00200		DATA QLINE/140.0/,HX/2./,SLSP/11.0/,DIV/4./
00300	C  QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00400	
00500		COMMON /MNX/MIN,MAX,JT
00600		COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00700		1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2 
00800		COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
00900		1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512) 
01000		1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
01100		COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
01200		COMMON/STF/RSTFAC(-3/4),RSTJ2 /SIZE/SIZE
01300		COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
01400		1/PX/KPN(300) /Q/Q(2001) /PTR/KWDS(300) /XRN/RN(2000)/NBAR/NBAR(36)
01500		EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
01600		1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000))
01700		1,(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
01800	C  TRNSP'S Bb, F, BBb, A, G, Eb.
01900	145	FORMAT(F,2I)
02000		CALL GETEXT('BARS','PAG')
02100		CALL EXTIN(KBAR,512)
02200		CALL EXTIN(RSTFAC,128)
02300	2000	TYPE 144,RSTJ2
02400	144	FORMAT(' STAFF SIZE='F4.2,'  CHANGE TO '$)
02500		ACCEPT 145,SIZE,LPT
02600		IF(SIZE.NE.0)GO TO 101
02700		SIZE=1
02800	101	JTOT=0
02900		ITOT=0
03000		DO 22 K=1,KT
03100		JJ=BARS(K)*SIZE+.5
03200		ITOT=ITOT+JJ
03300		JBAR(K)=JJ
03400	22	JTOT=JTOT+JJ
03500		ITOT=TOT*SIZE
03600	33	IF(RSTJ2.EQ.0)RSTJ2=1 
03700		RA=JPG*SIZE*RSTJ2
03800		MPG=10./RA
03900	C  MPG=NUM OF BRACES PER PAGE.
04000		SPG=10./MPG
04100	C  SPG IS SPACE TO BE SET ABOVE STAFF 0
04200		RA=(RSTJ2*SIZE)/RPSZ(1)
04300		DO 141 K=1,JPG
04400	141	RPSZ(K)=RPSZ(K)*RA
04500		LPG=JPG
04600	
04700	140	TYPE 90,KT
04800		RA=0
04900	90	FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
05000		
05100		JT=ITOT/140
05200	C  USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
05300	16	NT=JT
05310		JDIF=0
05400		L=0
05500		KTOT=JTOT
05600		KAV=KTOT/JT
05700		LMIN=-1
05800		LMAX=10000
05900		NJ=0
06000		LJ=0
06100		LMM=-1
06200		LDIF=10000
06300		NBAR(1)=1
06400		J=1
06500	3	M=1
06600		JAV=KTOT/NT
06700		K=JBAR(J)
06800	1	J=J+1
06900		IF(J.GT.KT)GO TO 2
07000		N=JBAR(J)
07100		IF(K+N/2.GE.JAV)GO TO 2
07200		M=M+1
07300		K=K+N
07400		GO TO 1
07500	2	L=L+1
07600		KTOT=KTOT-K
07700		NT=NT-1
07800		JRN(L)=K
07900		NBAR(L+1)=J
08000		IF(NT.GT.0)GO TO 3
08100	5	MAX=0
08200		MIN=10000
08300	
08400		DO 7 L=1,JT
08500		K=JRN(L)
08600		IF(K.LE.MAX)GO TO 6
08700		MAX=K
08800		MX=L
08900	6	IF(K.GE.MIN)GO TO 7
09000		MIN=K
09100		MN=L
09200	7	CONTINUE
09300	
09400		J=MAX-MIN
09500		IF(MAX.GE.LMAX.AND.J.GE.LDIF)GO TO 9
09600		IF(MIN.GT.LMIN)LMIN=MIN
09700		IF(MAX.LT.LMAX)LMAX=MAX
09800		IF(J.LT.LDIF)LDIF=J
09900		CALL STORE(NBAR)
10000	
10100		IF(MX.LT.MN)GO TO 32
10200		JJ=0
10300		JM=-1
10400		JK=1
10500	23	K=NBAR(MX+JJ)-JJ
10600	C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
10700		MM=JBAR(K)
10800		JRN(MX)=JRN(MX)-MM
10900		JRN(MX+JM)=JRN(MX+JM)+MM
11000		NBAR(MX+JJ)=K+JK
11100		MX=MX+JM
11200		IF(JJ.NE.0)GO TO 223
11300		IF(MX.GT.MN)GO TO 23
11400		GO TO 5 
11500	223	IF(MX.LT.MN)GO TO 23
11600		GO TO 5 
11700	32	JJ=1
11800		JM=1
11900		JK=0
12000		GO TO 23
12100	9	CALL GET(NBAR,JBAR)
12200		IDIF=10000
12300		JJT=JT-1
12400	104	CALL MNMX(IDIF)
12500	108	DO 102 J=1,JJT
12600		IF(JRN(J).LE.KAV)GO TO  102
12700	C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
12800		I=NBAR(J+1)-1
12900		IF(I.EQ.NBAR(J))GO TO 102
13000	C WE'RE DOWN TO ONE BAR
13100		JJ=JRN(J)-JBAR(I)
13200	C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
13300		IF(JJ.LT.MIN)GO TO 102
13400		KK=JRN(J+1)+JBAR(I)
13500		IF(KK.GT.MAX)GO TO 103
13600	C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
13700		CALL MINMAX
13800	105	JRN(J)=JJ
13900		JRN(J+1)=KK
14000		NBAR(J+1)=NBAR(J+1)-1
14100		GO TO 104
14200	103	IF(J.EQ.JJT)GO TO 102
14300		NN=KK
14400		DO 106 K=J+1,JJT
14500		LL=NBAR(K+1)-1
14600	C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
14700		MM=NN-JBAR(LL)
14800		IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 102
14900		NN=JBAR(LL)+JRN(K+1)
15000	106	IF(NN.LE.MAX)GO TO 105
15100	102	CONTINUE
15200	204	CALL MNMX(IDIF)
15300	208	DO 202 J=JT,2,-1
15400		IF(JRN(J).LE.KAV)GO TO  202
15500	C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
15600		I=NBAR(J)
15700		IF(I-1.EQ.NBAR(J-1))GO TO 202
15800	C WE'RE DOWN TO ONE BAR
15900		JJ=JRN(J)-JBAR(I)
16000	C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
16100		IF(JJ.LT.MIN)GO TO 202
16200		KK=JRN(J-1)+JBAR(I)
16300		IF(KK.GT.MAX)GO TO 203
16400	C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
16500		CALL MINMAX
16600	205	JRN(J)=JJ
16700		JRN(J-1)=KK
16800		NBAR(J)=NBAR(J)+1
16900		GO TO 204
17000	203	IF(J.EQ.2)GO TO 202
17100		NN=KK
17200		DO 206 K=J-1,2,-1
17300		LL=NBAR(K)
17400	C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
17500		MM=NN-JBAR(LL)
17600		IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 202
17700		NN=JBAR(LL)+JRN(K-1)
17800	206	IF(NN.LE.MAX)GO TO 205
17900	202	CONTINUE
18000	
18100		CALL MINMAX
18200		IDIF=MAX-MIN
18300		CALL STORE(NBAR)
18400	400	MX=MAX+5
18500		JR=1
18600	C  JR = HOW MANY BARS TO RIPPLE
18700	 	I=MAX-MIN
18800		IF(I.GT.IDIF)GO TO 402
18900		CALL STORE(NBAR)
19000		IDIF=I
19100	402	DO 401 J=1,JT
19200	401	IF(JRN(J).EQ.MIN)GO TO 408
19300	C  TRY RIPPLE EACH WAY FROM SMALLEST VALUE
19400	408	IF(J.EQ.JT)GO TO 508
19500	C RIPPLE FORWARD FIRST
19600		I=NBAR(J+1)
19700		JJ=JRN(J)+JBAR(I)
19800		IF(JJ.GT.MX)GO TO 508
19900	C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
20000		NN=JRN(J+1)-JBAR(I)
20100		IF(NN.LT.MIN)GO TO 404
20200	C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
20300		JRN(J)=JJ
20400		JRN(J+1)=NN
20500		NBAR(J+1)=I+1
20600	CC	NBAR(J+1)=NBAR(J+1)+1
20700	415	CALL MINMAX
20800	C NOW GO BACK AND TRY AGAIN.
20900		GO TO 400
21000	
21100	405	JRN(J)=JJ
21200	
21300		DO 422 IB=J+1,N
21400		LB=NBAR(IB)
21500		JB=JRN(IB)-JBAR(LB)
21600		NBAR(IB)=LB+1
21700		IF(JB.LT.MIN)GO TO 421
21800		JRN(IB)=JB
21900		GO TO 415
22000	
22100	421	IBB=IB+1
22200		LC=NBAR(IBB)
22300		JB=JB+JBAR(LC)
22400		IF(JB.GT.MIN)GO TO 422
22500	C NOW ADD A SECOND BAR
22600		JRN(IBB)=JRN(IBB)-JBAR(LC)
22700		LC=LC+1
22800		JB=JB+JBAR(LC)
22900		NBAR(IBB)=LC
23000	
23100	422	JRN(IB)=JB
23200		NBAR(IBB)=LC+1
23300		JRN(IBB)=JRN(IBB)-JBAR(LC)
23400		GO TO 415
23500	C NOW GO BACK AND TRY AGAIN.
23600		
23700	404	IF(J.EQ.JJT)GO TO 508
23800		DO 406 N=J+1,JJT
23900	  	LL=NBAR(N+1)
24000		MM=NN+JBAR(LL)
24100		IF(MM.GT.MX)GO TO 508
24200		IF(MM.GT.MIN)GO TO 409
24300	C NEXT TO RIPPLE 2 BARS!
24400	412	MN=MM+JBAR(LL+1)
24500	C  ADD ON A SECOND BAR
24600		IF(MN.GT.MX)GO TO 508
24700	C DON'T WORRY ABOUT IT BEING TOO SMALL (YET)
24800		NN=JRN(N+1)-JBAR(LL)-JBAR(LL+1)
24900		IF(NN.GT.MIN)GO TO 405
25000		GO TO 406
25100	
25200	409	NN=JRN(N+1)-JBAR(LL)
25300		IF(NN.GE.MIN)GO TO 405
25400	406	CONTINUE
25500	
25600	C  TRY RIPPLE EACH WAY FROM SMALLEST VALUE
25700	508	IF(J.EQ.1)GO TO 502
25800		IF(J.EQ.LJ.AND.MX-MN.EQ.LMM)GO TO 502
25900	C THIS SHOULD AVOID GETTING INTO A LOOP
25910		IF(JDIF.EQ.IDIF)GO TO 150
25920		ICNT=0
25930		GO TO 151
25940	150	ICNT=ICNT+1
25950		IF(ICNT.EQ.10)GO TO 515
25960	151	JDIF=IDIF
26000		LJ=J
26100		LMM=MX-MN
26200	C RIPPLE BACK NOW
26300		I=NBAR(J)-1
26400		JJ=JRN(J)+JBAR(I)
26500		IF(JJ.GT.MX)GO TO 502
26600	C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
26700		NN=JRN(J-1)-JBAR(I)
26800		IF(NN.LT.MIN)GO TO 504
26900	C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
27000		JRN(J)=JJ
27100		JRN(J-1)=NN
27200		NBAR(J)=I
27300		GO TO 415
27400	505	JRN(J)=JJ
27500		DO 522 IB=J-1,N,-1
27600		LB=NBAR(IB+1)-1
27700		JB=JRN(IB)-JBAR(LB)
27800		NBAR(IB+1)=LB
27900		IF(JB.LT.MIN)GO TO 521
28000		JRN(IB)=JB
28100		GO TO 415
28200	521	IBB=IB-1
28300		LC=NBAR(IB)-1
28400		JB=JB+JBAR(LC)
28500		IF(JB.GT.MIN)GO TO 522
28600		JB=JB+JBAR(LC-1)
28700		NBAR(IB)=LC
28800		JRN(IBB)=JRN(IBB)-JBAR(LC)
28900	CHECK THIS OUT!!
29000		LC=LC-1
29100	522	JRN(IB)=JB
29200		JRN(IBB)=JRN(IBB)-JBAR(LC)
29300	CC	NBAR(IB)=NBAR(IB)-1
29400		NBAR(IB)=LC
29500		GO TO 415
29600	504	IF(J.LE.2)GO TO 502
29700		DO 506 N=J-1,2,-1
29800	 	LL=NBAR(N)-1
29900		MM=NN+JBAR(LL)
30000		IF(MM.GT.MX)GO TO 502
30100		IF(MM.GT.MIN)GO TO 509
30200	512	MN=MM+JBAR(LL-1)
30300		IF(MN.GT.MX)GO TO 502
30400		NN=JRN(N-1)-JBAR(LL)-JBAR(LL-1)
30500		IF(NN.GT.MIN)GO TO 505
30600		GO TO 506
30700	509	NN=JRN(N-1)-JBAR(LL)
30800		IF(NN.GE.MIN)GO TO 505
30900	506	CONTINUE
31000	502	IF(J.EQ.NJ.AND.MX-MN.EQ.LMM)GO TO 515
31100	C  CHECK TO AVOID ENDLESS LOOP.
31200		NJ=J
31300		IF(J.EQ.JT)GO TO 515
31400	C LOOK FOR OTHER LINES = MIN.
31500		DO 510 K=J+1,JT
31600		IF(JRN(K).NE.MIN)GO TO 510
31700		J=K
31800		GO TO 408
31900	510	CONTINUE
32000	
32100	515	CALL GET(NBAR,JBAR)
32200	13	DO 14 L=2,JT
32300		K=NBAR(L)
32400		MM=JRN(L)
32500		NN=JRN(L-1)
32600		IF(MM.GE.NN)GO TO 12
32700	C  JUGGLES ADJACENT LINES
32800		N=JBAR(K-1)
32900		IF(NN-MM.LT.N)GO TO 14
33000		JRN(L-1)=NN-N
33100		JRN(L)=MM+N
33200		NBAR(L)=K-1
33300		GO TO 13
33400	12	N=JBAR(K)
33500		IF(MM-NN.LE.N)GO TO 14
33600		JRN(L-1)=NN+N
33700		JRN(L)=MM-N
33800		NBAR(L)=K+1
33900		GO TO 13
34000	14	CONTINUE
34100	46	J=1
34200		NBAR(JT+1)=KT+1
34300		JAV=JTOT/JT
34400		CALL MINMAX
34500		TYPE 308,JAV,MIN,MAX
34600		IF(LPT.NE.0)PRINT 308,JAV,MIN,MAX
34700	307	DO 305 K=1,JT
34800		NBAR(K)=NBAR(K+1)-NBAR(K)
34900	C NBAR NOW HAS NUM. OF BARS PER LINE.
35000		L=NBAR(K)-1+J
35100	306	FORMAT(I5,3X8I5)
35200	308	FORMAT(' AVG=',I3,'  MIN=',I3,'  MAX=',I3)
35300		TYPE 306,JRN(K),(JBAR(N),N=J,L)
35400		IF(LPT.NE.0)PRINT 306,JRN(K),(JBAR(N),N=J,L)
35500	305	J=L+1
35600		NBAR(JT+1)=0
35700		
35800		RPG=JT
35900		RPG=RPG/MPG
36000	95	TYPE 94,RPG,JT
36100		IF(LPT.NE.0)PRINT 94,RPG,JT
36200	94	FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
36300	C  FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
36400		KA=0
36500		ACCEPT 145,T,N,KL
36600	C  TYPE 0,n  TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
36700		JT=T
36800		IF(N.EQ.0)GO TO 16
36900	C N=0 MEANS T= NUM OF LINES DESIRED.
37000		END
37100	
37200		SUBROUTINE MINMAX
37300		COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
37400		MIN=10000
37500		MAX=0
37600		DO 107 K=1,JT
37700		NN=JRN(K)
37800		IF(NN.LT.MIN)MIN=NN
37900	107	IF(NN.GT.MAX)MAX=NN
38000		END
38100	
38200		SUBROUTINE STORE(NBAR)
38300		COMMON /MNX/MIN,MAX,JT
38400		DIMENSION NBAR(1)
38500		COMMON /MB/MB(500)
38600		DO 1 K=2,JT+1
38700	1	MB(K)=NBAR(K)
38800		END
38900	
39000		SUBROUTINE GET(NBAR,JBAR)
39100		COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
39200		DIMENSION NBAR(1),JBAR(1)
39300		COMMON /MB/MB(500)
39400		J=1
39500		DO 1 K=2,JT+1
39600		NBAR(K)=MB(K)
39700		N=0
39800		DO 2 L=J,MB(K)-1
39900	C FIX UP JRN ARRAY
40000	2	N=N+JBAR(L)
40100		JRN(K-1)=N
40200	1	J=MB(K)
40300		END
40400	
40500		SUBROUTINE MNMX(IDIF)
40600		COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
40700		L=MIN
40800	 	N=MAX
40900		CALL MINMAX
41000		J=MAX-MIN
41100		IF(J.LE.IDIF)GO TO 1
41200		MIN=L
41300		MAX=N
41400		RETURN
41500	1	IDIF=J
41600		END